Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE19/SERIAL/COMMDEV.PAS

Pascal/Delphi Source File | 1997-01-26 | 26.9 KB | 860 lines

unit CommDev;

interface

uses WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Forms;

type
  TFlowControl = (fcNone,fcHardwareDSRDTR,fcHardwareCTSRTS,fcSoftware);

  TOnDataEvent = procedure(Buffer: Pointer; Length: Integer) of object;
  TOnErrEvent = procedure of object;
  TOnLineStatusChange = procedure(LineStatus: Boolean) of object;

type
  TCommDevice = class
    private
      FBaudRate: Word;
      FCtsTimeOut: Word;
      FDeviceId: Integer;
      FDataBits: Byte;
      FDCB: TDCB;
      FDoingDataReceive: Boolean;
      FDoingDataTransmit: Boolean;
      FDsrTimeOut: Word;
      FEvents: Word;
      FFlowControl: TFlowControl;
      FInitString: string;
      FNotifyWindow: HWnd;
      FOnBreak: TOnErrEvent;
      FOnCDChange: TOnLineStatusChange;
      FOnCTSChange: TOnLineStatusChange;
      FOnDSRChange: TOnLineStatusChange;
      FOnData: TOnDataEvent;
      FOnFrameErr: TOnErrEvent;
      FOnOverrunErr: TOnErrEvent;
      FOnParityErr: TOnErrEvent;
      FParity: Byte;
      FParityCheck: Boolean;
      FParityDoReplaceChar: Boolean;
      FParityReplacementChar: Char;
      FReadBuffer: PChar; { }
      FReceiveQueueSize: Integer;
      FStopBits: Byte;
      FTempOutputStoredBytes: Integer; { }
      FTempOutBuffer: PChar; { }
      FTransmitQueueSize: Integer;
      FXFlowOffLimit: Word;
      FXFlowOnLimit: Word;
      FXoffChar: Char;
      FXonChar: Char;
      { Property access routines }
      function  GetCDHigh: Boolean;
      function  GetCTSHigh: Boolean;
      function  GetDeviceId: Integer;
      function  GetDSRHigh: Boolean;
      function  GetInputByteCount: Integer;
      function  GetOutpuByteCount: Integer;
      function  GetDeviceOpen: Boolean;
      function  GetRIHigh: Boolean;
      procedure SetBaudRate(Value: Word);
      procedure SetDataBits(Value: Byte);
      procedure SetParity(Value: Byte);
      procedure SetReceiveQueueSize(Value: Integer);
      procedure SetStopBits(Value: Byte);
      procedure SetTransmitQueueSize(Value: Integer);
      { Other private routines }
      procedure ConfigureDevice;
      procedure InitialiseDevice;
      procedure NotifyProcedure(var Message: TMessage);
      procedure ProcessComError(Errors: Word);
      procedure StoreRemainderInTempBuffer(Buff: PChar; BuffLen,BytesLeft: Integer);
    protected
      property  DeviceId: Integer read GetDeviceId;
    public
      { Constructor/destructor }
      Constructor Create;
      Destructor Destroy; override;
      { Public methods }
      procedure BreakTransmission;
      procedure Close;
      function  Dial(const Number: string): Boolean;
      function  FlushInput: Boolean;
      function  FlushOutput: Boolean;
      procedure HangUp;
      procedure Open(Port: Integer);
      procedure ResumeTransmission;
      function  Write(Buff: PChar; BuffLen: Integer): Boolean;
      function  WriteLn(const S: string): Boolean;
      { Properties }
      property BaudRate: Word read FDCB.BaudRate write SetBaudRate;
      property CDHigh: Boolean read GetCDHigh;
      property CTSHigh: Boolean read GetCTSHigh;
      property CtsTimeOut: Word read FCtsTimeout write FCtsTimeout;
      property DataBits: Byte read FDCB.ByteSize write SetDataBits;
      property DSRHigh: Boolean read GetDSRHigh;
      property DsrTimeOut: Word read FDsrTimeout write FDsrTimeout;
      property FlowControl: TFlowControl read FFlowControl write FFlowControl;
      property InitString: string read FInitString write FinitString;
      property InputByteCount: Integer read GetInputByteCount;
      property OutputByteCount: Integer read GetOutpuByteCount;
      property Parity: Byte read FDCB.Parity write SetParity;
      property ParityCheck: Boolean read FParityCheck write FParityCheck;
      property ParityDoReplaceChar: Boolean read FParityDoReplaceChar write FParityDoReplaceChar;
      property ParityReplacementChar: Char read FParityReplacementChar write FParityReplacementChar;
      property DeviceOpen: Boolean read GetDeviceOpen;
      property ReceiveQueueSize: Integer read FReceiveQueueSize write SetReceiveQueueSize;
      property RIHigh: Boolean read GetRIHigh;
      property StopBits: Byte read FDCB.StopBits write SetStopBits;
      property TransmitQueueSize: Integer read FTransmitQueueSize write SetTransmitQueueSize;
      property XFlowOffLimit: Word read FXFlowOffLimit write FXFlowOffLimit;
      property XFlowOnLimit: Word read FXFlowOnLimit write FXFlowOnLimit;
      property XOffChar: Char read FXOffChar write FXOffChar;
      property XOnChar: Char read FXOnChar write FXOnChar;
      { Events }
      property OnBreak: TOnErrEvent read FOnBreak write FOnBreak;
      property OnCDChange: TOnLineStatusChange read FOnCDChange write FOnCDChange;
      property OnCTSChange: TOnLineStatusChange read FOnCTSChange write FOnCTSChange;
      property OnData: TOnDataEvent read FOnData write FOnData;
      property OnDSRChange: TOnLineStatusChange read FOnDSRChange write FOnDSRChange;
      property OnOverrunErr: TOnErrEvent read FOnOverrunErr write FOnOverrunErr;
      property OnParityErr: TOnErrEvent read FOnParityErr write FOnParityErr;
      property OnFrameErr: TOnErrEvent read FOnFrameErr write FOnFrameErr;
  end;

implementation

const
  ByteNotSet      = $FF;
  DefaultInBuffer = 2048;
  DefaultOutBuffer = 2048;
  DefaultXflowTimeout = 300;
  DeviceNotOpen = -1;
  DialPrefix      = 'ATDT';
  OutBufferSize = 4096;
  ReadBufferSize  = 4096;
  ReceiveTrigger  = -1;  { We use EV_RXCHAR instead }
  TransmitTrigger = -1;  { We use EV_TXEMPTY to write backlog to the driver }

{ From the article in the MSDN }

const
  COMM_MSRShaddow = 35;
  MSR_CTS         = $10;
  MSR_DSR         = $20;
  MSR_RI          = $40;
  MSR_CD          = $80;

{==============================================================================}
Constructor TCommDevice.Create;
begin
  FDeviceId := DeviceNotOpen;
  FReceiveQueueSize := DefaultInBuffer;
  FTransmitQueueSize := DefaultOutBuffer;
  FParity := ByteNotSet;
  FStopBits := ByteNotSet;
  FCtsTimeOut := DefaultXflowTimeout;
  FDsrTimeOut := DefaultXflowTimeout;
  FXonChar := #17;
  FXoffChar := #19;
  FXFlowOnLimit := 32;
  FXFlowOffLimit := 512;
  FParityCheck := True;
  FParityDoReplaceChar := True;
  FParityReplacementChar := '*';
  FInitString := 'ATZ';
  FEvents := EV_RXCHAR or EV_TXEMPTY or EV_ERR or EV_BREAK or EV_CTS or EV_DSR or EV_RLSD;
  FReadBuffer := MemAlloc(ReadBufferSize);
  if FReadBuffer = nil then
    Raise Exception.Create('MemAlloc failed creating internal buffer');
  FTempOutBuffer := MemAlloc(OutBufferSize);
  if FTempOutBuffer = nil then
    Raise Exception.Create('MemAlloc failed creating temporary output buffer');
end;
{==============================================================================}
Destructor TCommDevice.Destroy;
begin
  Close;
  if FReadBuffer <> nil then
    FreeMem(FReadBuffer,ReadBufferSize);
  if FTempOutBuffer <> nil then
    FreeMem(FTempOutBuffer,OutBufferSize);
  inherited Destroy;
end;
{==============================================================================}
{ As SetCommBreak would overwrite any data currently being transmitted we keep }
{ checking the number of characters waiting to be transmitted to ensure that   }
{ is zero before we cause the device driver to drop the TX line. Subject to a  }
{ 5 second delay.                                                              }
procedure TCommDevice.BreakTransmission;
var
  StartTicks: LongInt;

begin
  if DeviceOpen then
    begin
      StartTicks := GetTickCount;
      While OutputByteCount > 0 do
        begin
          Application.ProcessMessages;
          if GetTickCount - StartTicks > 5000 then
            Break;
        end;
      SetCommBreak(DeviceId);
    end;
end;
{==============================================================================}
procedure TCommDevice.Close;
begin
  if DeviceOpen then
    begin
      if FNotifyWindow <> 0 then
    begin
      EnableCommNotification(DeviceId,0,-1,-1);
      DeallocateHWnd(FNotifyWindow);
      FNotifyWindow := 0;
    end;
      if DeviceOpen then
    CloseComm(DeviceId);
      FDeviceId := DeviceNotOpen;
      FillChar(FDCB,sizeof(TDCB),0);
    end;
end;
{==============================================================================}
{ Called from the Open method to apply stored parameters to the commDevice     }
procedure TCommDevice.ConfigureDevice;
var
  RC: Integer;

begin
  RC := GetCommState(FDeviceId,FDCB);
  If RC = 0 then
    begin
      if FBaudRate > 0 then
    FDCB.BaudRate := FBaudRate;
      if FDataBits > 0 then
    FDCB.ByteSize := FDataBits;
      if FParity <> ByteNotSet then
    FDCB.Parity := FParity;
      if FStopBits <> ByteNotSet then
    FDCB.StopBits := FStopBits;

      With FDCB do
    begin
      { Set flow control }

      Flags := dcb_Binary;
      XOnLim := 0;
      XOffLim := 0;
      CtsTimeOut := 0;
      DsrTimeOut := 0;
      XOnChar := #0;
      XOffChar := #0;

      case FFlowControl of

        fcHardwareDSRDTR:
          begin
        Flags := Flags or dcb_OutxDsrFlow or dcb_Dtrflow;
        XOnLim := XFlowOnLimit;
        XOffLim := XFlowOffLimit;
        DsrTimeOut := FdsrTimeout;
          end;

        fcHardwareCTSRTS:
          begin
        Flags := Flags or dcb_OutxCtsFlow or dcb_Rtsflow;
        XOnLim := XFlowOnLimit;
        XOffLim := XFlowOffLimit;
        CtsTimeOut := FCtsTimeout;
          end;

        fcSoftware:
          begin
        Flags := Flags or dcb_InX or dcb_OutX;
        XOnLim := XFlowOnLimit;
        XOffLim := XFlowOffLimit;
        XOnChar := FXOnChar;
        XOffChar := FXOnChar;
          end;

      end;

      { Set parity checking options }

      if ParityCheck then
        Flags := flags or dcb_Parity;

      if ParityDoReplaceChar then
        begin
          Flags := flags or dcb_PeChar;
          FDCB.PeChar := ParityReplacementChar;
        end;

    end; { With FDCB do }

      RC := SetCommstate(FDCB);

      if RC = 0 then
    begin
      { Set up notification events }
      FNotifyWindow := AllocateHWnd(NotifyProcedure);
      SetCommEventMask(DeviceId,FEvents);
      EnableCommNotification(DeviceId,FNotifyWindow,ReceiveTrigger,TransmitTrigger);
    end
      else
    Raise Exception.CreateFmt('Failed to configure Device. SetCommstate ended with error %d.',[RC]);
    end
  else
    Raise Exception.CreateFmt('GetCommState ended with %d when trying to configure Device.',[RC]);
end;
{==============================================================================}
procedure TCommDevice.InitialiseDevice;
begin
  { Assert the DTR line }
  EscapeCommFunction(FDeviceId,SETDTR);
  FTempOutputStoredBytes := 0;
  if InitString <> '' then
    WriteLn(InitString);
end;
{==============================================================================}
function TCommDevice.Dial(const Number: string): Boolean;
begin
  Result := DeviceOpen;
  if DeviceOpen then
    WriteLn(DialPrefix + Number);
end;
{==============================================================================}
function TCommDevice.FlushInput: Boolean;
begin
  if DeviceOpen then
    Result := FlushComm(DeviceId,1) = 0
  else
    Result := False;
end;
{==============================================================================}
function TCommDevice.FlushOutput: Boolean;
begin
  if DeviceOpen then
    Result := FlushComm(DeviceId,0) = 0
  else
    Result := False;
end;
{==============================================================================}
function TCommDevice.GetCDHigh: Boolean;
begin
  if DeviceOpen then
    Result := (PByteArray(SetCommEventMask(DeviceId,FEvents))^[COMM_MSRShaddow] and MSR_CD) = MSR_CD
  else
    Result := False;
end;
{==============================================================================}
function TCommDevice.GetCTSHigh: Boolean;
begin
  if DeviceOpen then
    Result := (PByteArray(SetCommEventMask(DeviceId,FEvents))^[COMM_MSRShaddow] and MSR_CTS) = MSR_CTS;
end;
{==============================================================================}
function TCommDevice.GetDeviceId: Integer;
begin
  Result := FDeviceId;
end;
{==============================================================================}
function TCommDevice.GetDSRHigh: Boolean;
begin
  if DeviceOpen then
    Result := (PByteArray(SetCommEventMask(DeviceId,FEvents))^[COMM_MSRShaddow] and MSR_DSR) = MSR_DSR
  else
    Result := False;
end;
{==============================================================================}
function TCommDevice.GetInputByteCount: Integer;
var
  CommStat: TComStat;

begin
  if DeviceOpen then
    begin
      GetCommError(DeviceId,CommStat);
      Result := CommStat.cbInQue;
    end
  else
    Result := 0;
end;
{==============================================================================}
function TCommDevice.GetOutpuByteCount: Integer;
var
  ComStat: TComStat;

begin
  if DeviceOpen then
    begin
      GetCommError(DeviceId,ComStat);
      Result := ComStat.cbOutQue;
    end
  else
    Result := 0;
end;
{==============================================================================}
function TCommDevice.GetDeviceOpen: Boolean;
begin
  Result := DeviceId <> DeviceNotOpen;
end;
{==============================================================================}
function TCommDevice.GetRIHigh: Boolean;
begin
  if DeviceOpen then
    Result := (PByteArray(SetCommEventMask(DeviceId,FEvents))^[COMM_MSRShaddow] and MSR_RI) = MSR_RI
  else
    Result := False;
end;
{==============================================================================}
procedure TCommDevice.HangUp;
var
  StartTicks: LongInt;

begin
  if DeviceOpen then
    begin
      EscapeCommFunction(DeviceId,CLRDTR);
      StartTicks := GetTickCount;
      While GetTickCount - StartTicks < 500 do
    Application.ProcessMessages;
      EscapeCommFunction(DeviceId,SETDTR);
    end;
end;
{==============================================================================}
procedure TCommDevice.NotifyProcedure(var Message: TMessage);
var
  EventFlags: Word;
  LastError: Word;
  ComStat: TComStat;
  BytesRead: Integer;
  BytesWritten: Integer;
  Errors: Integer;

begin
  With Message do
    if (Msg = WM_COMMNOTIFY) and (wParam = DeviceId) then
      begin
    { Although we pass -1 to EnableCommnotification this has been added to }
    { show how you could process this trigger.                             }
    if LoWord(LParam) and CN_RECEIVE = CN_RECEIVE then
      begin
        { This flag is to ensure that this code is not executed the if     }
        { another message is received while we are reading the data.       }
        if not FDoingDataReceive then
          begin
        FDoingDataReceive := True;
        try
          BytesRead := ReadComm(DeviceId,FReadBuffer,ReadBufferSize);
          while BytesRead > 0 do
            begin
              if Assigned(FOnData) then
            FOnData(FReadBuffer,BytesRead);
              Application.ProcessMessages;
              BytesRead := ReadComm(DeviceId,FReadBuffer,ReadBufferSize);
            end;
          if BytesRead <=0 then
            begin
                      Errors := GetCommError(DeviceId,ComStat);
                      if Errors <> 0 then
                        ProcessComError(Errors);
            end;
        finally
          FDoingDataReceive := False;
        end;
          end;
      end;
    { Although we pass -1 to EnableCommnotification this has been added to }
    { show how you could process this trigger.                             }
    if LoWord(LParam) and CN_TRANSMIT = CN_TRANSMIT then
      begin
        { This flag is to ensure that this code is not executed the if     }
        { another message is received while we are writing the data.       }
        if not FDoingDataTransmit then
          begin
        FDoingDataTransmit := True;
        try
          if FTempOutputStoredBytes <> 0 then
            begin
              BytesWritten := WriteComm(DeviceId,FTempOutBuffer,FTempOutputStoredBytes);
              if BytesWritten < 0 then
            begin
              Errors := GetCommError(DeviceId,ComStat);
              ProcessComError(Errors);
              BytesWritten := -BytesWritten;
              StoreRemainderInTempBuffer(FTempOutBuffer,FTempOutputStoredBytes,
                FTempOutputStoredBytes - BytesWritten);
            end
              else
            if BytesWritten = 0 then
              begin
                   Errors := GetCommError(DeviceId,ComStat);
                if Errors <> 0 then
                              ProcessComError(Errors);
                            StoreRemainderInTempBuffer(FTempOutBuffer,FTempOutputStoredBytes,FTempOutputStoredBytes);
              end
            else
              if BytesWritten < FTempOutputStoredBytes then
                begin
                  StoreRemainderInTempBuffer(FTempOutBuffer,FTempOutputStoredBytes,
                FTempOutputStoredBytes - BytesWritten);
                end
              else
                FTempOutputStoredBytes := 0;
            end
        finally
          FDoingDataTransmit := False;
        end;
          end;
      end;

    if LoWord(LParam) and CN_EVENT = CN_EVENT then
      begin
        EventFlags := GetCommEventMask(DeviceId,FEvents);
        LastError := GetCommError(DeviceId,ComStat);

        { Process data if we have received it }

        if EventFlags and EV_RXCHAR = EV_RXCHAR then
          begin
        if not FDoingDataReceive then
          begin
            FDoingDataReceive := True;
            try
              BytesRead := ReadComm(DeviceId,FReadBuffer,ReadBufferSize);
              while BytesRead > 0 do
            begin
              if Assigned(FOnData) then
                FOnData(FReadBuffer,BytesRead);
              Application.ProcessMessages;
              BytesRead := ReadComm(DeviceId,FReadBuffer,ReadBufferSize);
            end;
               if BytesRead <=0 then
                begin
                          Errors := GetCommError(DeviceId,ComStat);
                          if Errors <> 0 then
                            ProcessComError(Errors);
                 end;
            finally
              FDoingDataReceive := False;
            end;
          end;
          end;

        if EventFlags and EV_TXEMPTY = EV_TXEMPTY then
          begin
        { This flag is to ensure that this code is not executed the if }
        { another message is received while we are transmitting the    }
        { temp data buffer.                                            }
        if not FDoingDataTransmit then
          begin
            FDoingDataTransmit := True;
            try
              if FTempOutputStoredBytes <> 0 then
            begin
              BytesWritten := WriteComm(DeviceId,FTempOutBuffer,FTempOutputStoredBytes);
              if BytesWritten < 0 then
                begin
                  Errors := GetCommError(DeviceId,ComStat);
                  ProcessComError(Errors);
                  BytesWritten := -BytesWritten;
                  StoreRemainderInTempBuffer(FTempOutBuffer,FTempOutputStoredBytes,
                FTempOutputStoredBytes - BytesWritten);
                end
              else
                if BytesWritten = 0 then
                  begin
                                Errors := GetCommError(DeviceId,ComStat);
                                if Errors <> 0 then
                                  ProcessComError(Errors);
                StoreRemainderInTempBuffer(FTempOutBuffer,FTempOutputStoredBytes,FTempOutputStoredBytes);
                  end
                else
                  if BytesWritten < FTempOutputStoredBytes then
                begin
                  StoreRemainderInTempBuffer(FTempOutBuffer,FTempOutputStoredBytes,
                    FTempOutputStoredBytes - BytesWritten);
                end
                  else
                FTempOutputStoredBytes := 0;
                end
            finally
              FDoingDataTransmit := False;
            end;
          end;
          end;

        if EventFlags and EV_ERR = EV_ERR then
          begin
        { A hardware generated error }
                ProcessComError(LastError);
          end;

        if EventFlags and EV_CTS = EV_CTS then
          if Assigned(FOnCTSChange) then
        FOnCTSChange(CTSHigh);

        if EventFlags and EV_DSR = EV_DSR then
          if Assigned(FOnDSRChange) then
        FOnDSRChange(DSRHigh);

        if EventFlags and EV_RLSD = EV_RLSD then
          if Assigned(FOnCDChange) then
        FOnCDChange(CDHigh);

        if EventFlags and EV_BREAK = EV_BREAK then
          if Assigned(FOnBreak) then
        FOnBreak;
      end;
      end;
end;
{==============================================================================}
procedure TCommDevice.Open(Port: Integer);
var
  CommDeviceName: array[0..4] of char;
  TmpID: Integer;

begin
  if not DeviceOpen then
    begin
      TmpID := OpenComm(StrPCopy(CommDeviceName,Format('COM%D',[Port])),ReceiveQueueSize,TransmitQueueSize);
      try
    case TmpID of
      0..32767:
        begin
          FDeviceID := TmpID;
          ConfigureDevice;
          InitialiseDevice;
        end;
      IE_BADID:    Raise Exception.Create('The device identifier is invalid or unsupported.');
      IE_BAUDRATE: Raise Exception.Create('The device''s baud rate is unsupported.');
      IE_BYTESIZE: Raise Exception.Create('The specified byte size is invalid.');
      IE_DEFAULT:  Raise Exception.Create('The default parameters are in error.');
      IE_HARDWARE: Raise Exception.Create('The hardware is not available (is locked by another device).');
      IE_MEMORY:   Raise Exception.Create('The function cannot allocate the queues.');
      IE_NOPEN:    Raise Exception.Create('The device is not open.');
      IE_OPEN:     Raise Exception.Create('The device is already open.');
    else
      Raise Exception.CreateFmt('OpenComm failed with error %d.',[FDeviceId]);
    end;
      except
    on Exception do
      begin
        CloseComm(FDeviceId);
        FDeviceId := DeviceNotOpen;
        Raise;
      end;
      end;

    end
  else
    Raise Exception.Create('Device is already open');
end;
{==============================================================================}
{ See the on-line help for GetCommError for other errors which could be trapped}
procedure TCommDevice.ProcessComError(Errors: Word);
begin
  if Errors and CE_RXPARITY = CE_RXPARITY then
    if Assigned(FOnParityErr) then
      FOnParityErr;
  if Errors and CE_OVERRUN = CE_OVERRUN then
    if Assigned(FOnOverrunErr) then
      FOnOverrunErr;
  if Errors and CE_FRAME = CE_FRAME then
    if Assigned(FOnFrameErr) then
      FOnFrameErr;
end;
{==============================================================================}
procedure TCommDevice.ResumeTransmission;
begin
  ClearCommBreak(DeviceId);
end;
{==============================================================================}
procedure TCommDevice.SetBaudRate(Value: Word);
var
  OldBaudRate: Word;
  RC: Integer;

begin
 FBaudRate := Value;
 if DeviceOpen then
   begin
     OldBaudRate := FDCB.BaudRate;
     FDCB.BaudRate := Value;
     RC := SetCommstate(FDCB);
     if RC <> 0 then
       begin
     FDCB.BaudRate := OldBaudRate;
     Raise Exception.CreateFmt('Failed to change Device baud rate. SetCommstate ended with error %d.',[RC]);
       end;
   end;
end;
{==============================================================================}
procedure TCommDevice.SetDataBits(Value: Byte);
var
  OldByteSize: Byte;
  RC: Integer;

begin
  if Value in [5..8] then
    begin
      FDataBits := Value;
      if DeviceOpen then
    begin
      OldByteSize := FDCB.ByteSize;
      FDCB.ByteSize := Value;
      RC := SetCommstate(FDCB);
      if RC <> 0 then
        begin
          FDCB.ByteSize := OldByteSize;
          Raise Exception.CreateFmt('Failed to change Device data size. SetCommstate ended with error %d.',[RC]);
        end;
    end
    end;
end;
{==============================================================================}
procedure TCommDevice.SetParity(Value: Byte);
var
  OldParity: Byte;
  RC: Integer;

begin
  if Value in [NOPARITY,ODDPARITY,EVENPARITY,MARKPARITY,SPACEPARITY] then
    begin
      FParity := Value;
      if DeviceOpen then
    begin
      OldParity := FDCB.Parity;
      FDCB.Parity := Value;
      RC := SetCommstate(FDCB);
      if RC <> 0 then
        begin
          FDCB.Parity := OldParity;
          Raise Exception.CreateFmt('Failed to change Device parity option. SetCommstate ended with error %d.',[RC]);
        end;
    end
    end;
end;
{==============================================================================}
procedure TCommDevice.SetReceiveQueueSize(Value: Integer);
begin
  if Value > 0 then
    FReceiveQueueSize := Value;
end;
{==============================================================================}
procedure TCommDevice.SetStopBits(Value: Byte);
var
  OldStopBits: Byte;
  RC: Integer;

begin
  If Value in [ONESTOPBIT,ONE5STOPBITS,TWOSTOPBITS] then
    begin
      FStopBits := Value;
      if DeviceOpen then
    begin
      OldStopBits := FDCB.StopBits;
      FDCB.StopBits := Value;
      RC := SetCommstate(FDCB);
      if RC <> 0 then
        begin
          FDCB.Parity := OldStopBits;
          Raise Exception.CreateFmt('Failed to change Device stop bits option. SetCommstate ended with error %d.',[RC]);
        end;
    end;
    end;
end;
{==============================================================================}
procedure TCommDevice.SetTransmitQueueSize(Value: Integer);
begin
  if Value > 0 then
    FTransmitQueueSize := Value;
end;
{==============================================================================}
procedure TCommDevice.StoreRemainderInTempBuffer(Buff: PChar; BuffLen,BytesLeft: Integer);
begin
  FTempOutputStoredBytes := BytesLeft;
  Move(Buff[BuffLen-BytesLeft],FTempOutBuffer^,BytesLeft);
end;
{==============================================================================}
{ This function will either write the whole block or nothing                   }
function TCommDevice.Write(Buff: PChar; BuffLen: Integer): Boolean;
var
  BytesWritten: Integer;
  Errors: Integer;
  Comstat: TComStat;
  StartTicks: LongInt;

begin
  if DeviceOpen then
    begin
      { If we are already waiting to send the last block, caller will have to  }
      { call us again after receiving false.                                   }
      Result := False;
      StartTicks := GetTickCount;
      While FTempOutputStoredBytes <> 0 do
    begin
      Application.ProcessMessages;
      if GetTickCount - StartTicks > 5000 then
        Break;
    end;
      if FTempOutputStoredBytes = 0 then
    begin
      BytesWritten := WriteComm(DeviceId,Buff,BuffLen);
      if BytesWritten < 0 then
        begin
          Errors := GetCommError(DeviceId,ComStat);
          ProcessComError(Errors);
          BytesWritten := -BytesWritten;
          StoreRemainderInTempBuffer(Buff,BuffLen,BuffLen - BytesWritten);
        end
      else
        if BytesWritten = 0 then
          begin
               Errors := GetCommError(DeviceId,ComStat);
                if Errors <> 0 then
                 ProcessComError(Errors);
        StoreRemainderInTempBuffer(Buff,BuffLen,BuffLen);
          end
        else
          if BytesWritten < BuffLen then
        begin
          StoreRemainderInTempBuffer(Buff,BuffLen,BuffLen - BytesWritten);
        end;
      Result := True;
    end;
    end
  else
    Raise Exception.Create('Comm Device is not open.');
end;
{==============================================================================}
function TCommDevice.WriteLn(const S: string): Boolean;
var
  Wrk: array[0..255] of char;
  StartTicks: LongInt;

  I: Integer;

begin
  Result := DeviceOpen;
  if Result then
    begin
      StrPCopy(Wrk,s);
      Wrk[Length(S)] := #13;
      StartTicks := GetTickCount;
      While not Write(Wrk,Length(S)+1) do
    begin
      Application.ProcessMessages;
      if GetTickCount - StartTicks > 5000 then
        begin
          Result := False;
          Break;
        end;
    end;
    end;
end;

end.